home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / prog / psdir101.zip / DIRS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-24  |  7KB  |  243 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║    Directory     ║
  5.                                                       ║    Procedures    ║
  6.                                                       ║    Rev. 1.01     ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. {$F-} {$O-} {$A+} {$G-}
  12. {$V-} {$B-} {$X-} {$N+} {$E+}
  13.  
  14. {$I FINAL.PAS}
  15.  
  16. {$IFDEF FINAL}
  17.   {$I-} {$R-}
  18.   {$D-} {$L-} {$S-}
  19. {$ENDIF}
  20.  
  21. Unit Dirs;
  22.  
  23. Interface
  24.  
  25. Uses DOS;
  26.  
  27. Const
  28.   StdFile       = Directory + ReadOnly + Archive;
  29.   Files         = 1;
  30.   Time          = 2;
  31.   Date          = 4;
  32.   Size          = 8;
  33.   Directories   = 16;
  34.  
  35. Type
  36.  
  37.   DirListInfo=^DirListing;                     {One File Information Element}
  38.  
  39.   DirList=Record                               {List of Files}
  40.             Total:Word;                        {Total Number of Files}
  41.             Root :Pointer;                     {Root Pointer}
  42.             Info :DirListInfo;                 {Linked List}
  43.           End;
  44.  
  45.   DirListing=Record                            {Information Record}
  46.                Attr:Byte;
  47.                Time,
  48.                Size:LongInt;
  49.                Name:String[12];
  50.                Next:Pointer;
  51.              End;
  52.  
  53. Function  IsDir      (FDir:String):Boolean;
  54. Procedure GoDir      (FDir:String);
  55. Procedure DelSlash   (StIn:String;Var StOut:String);
  56. Procedure AddSlash   (StIn:String;Var StOut:String);
  57. Procedure InitDirList(Var Dir:DirList);
  58. Procedure GotoDirList(Var Dir:DirList;Num:Word);
  59. Procedure KillDirList(Var Dir:DirList);
  60. Procedure LoadDirList(Var Dir:DirList;Mask:PathStr;Attr:Byte;IncDir:Byte);
  61.  
  62. Implementation
  63.  
  64. Function IsDir(FDir:String):Boolean;
  65.  
  66. { ╔════════════════════════════════════════════════════════════════════════╗ }
  67. { ║   Checks if FDir is a valid directory or not.                          ║ }
  68. { ╚════════════════════════════════════════════════════════════════════════╝ }
  69.  
  70. Var
  71.   T  :String[80];        {Old Drive and Directory}
  72.   Org:String[2];         {Original Drive}
  73.   Drv:Byte;              {New Drive Code}
  74.  
  75. Begin
  76.   GetDir(0,T);
  77.   Org:=' :';
  78.   Org[1]:=T[1];
  79.   Drv:=0;
  80.   If Length(FDir)>1 Then
  81.   Begin
  82.     If FDir[2]=':' Then
  83.     Begin
  84.       Drv:=Ord(UpCase(FDir[1]));
  85.       Drv:=Drv-Ord('A')+1;
  86.     End;
  87.   End;
  88.   GetDir(Drv,T);
  89.   {$I-}
  90.   ChDir(FDir);
  91.   If IOResult<>0 Then
  92.     IsDir:=False
  93.   Else
  94.     IsDir:=True;
  95.   ChDir(T);      {Go Back to Original Directory in New Drive}
  96.   ChDir(Org);    {Go Back to Old Drive}
  97.   {$IFNDEF FINAL} {$I+} {$ENDIF}
  98.   If IOResult<>0 Then;
  99. End;
  100.  
  101. Procedure GoDir(FDir:String);
  102.  
  103. { ╔════════════════════════════════════════════════════════════════════════╗ }
  104. { ║    Goes to the specified directory if it exists.                       ║ }
  105. { ╚════════════════════════════════════════════════════════════════════════╝ }
  106.  
  107. Var
  108.   Err:Word;
  109.  
  110. Begin
  111.   If (Length(FDir)>1) And (FDir[Length(FDir)]='\') Then
  112.     If (FDir[Length(FDir)-1]<>':') Then
  113.       Delete(FDir,Length(FDir),1);
  114.   {$I-}
  115.   ChDir(FDir);
  116.   {$IFNDEF FINAL} {$I+} {$ENDIF}
  117.   Err:=IOResult;
  118. End;
  119.  
  120. Procedure DelSlash(StIn:String;Var StOut:String);
  121. Begin
  122.   StOut:=StIn;
  123.   If (StOut[Length(StOut)]='\') Then
  124.     If (Length(StOut)>1) Then
  125.     Begin
  126.       If (StOut[Length(StOut)-1]<>':') Then
  127.         StOut[0]:=Chr(Length(StOut)-1);
  128.     End;
  129. End;
  130.  
  131. Procedure AddSlash(StIn:String;Var StOut:String);
  132. Begin
  133.   If StIn='' Then
  134.     StOut:=''
  135.   Else
  136.     If StIn[Length(StIn)]='\' Then
  137.       StOut:=StIn
  138.     Else
  139.       StOut:=StIn+'\';
  140. End;
  141.  
  142. Procedure InitDirList(Var Dir:DirList);
  143. Begin
  144.   Dir.Total:=0;
  145.   Dir.Root :=NIL;
  146.   Dir.Info :=NIL;
  147. End;
  148.  
  149. Procedure GotoDirList(Var Dir:DirList;Num:Word);
  150.  
  151. { ╔════════════════════════════════════════════════════════════════════════╗ }
  152. { ║  Goes to the directory position Num, with the first directory entry    ║ }
  153. { ║  being 1 and the last 65535 or Dir.Total.                              ║ }
  154. { ╚════════════════════════════════════════════════════════════════════════╝ }
  155.  
  156. Var
  157.   T:Word;
  158.  
  159. Begin
  160.   T:=1;
  161.   Dir.Info:=Dir.Root;
  162.   If Dir.Info=NIL Then Exit;
  163.   While (T<Num) And (Dir.Info^.Next<>NIL) do
  164.   Begin
  165.     Dir.Info:=Dir.Info^.Next;
  166.     Inc(T);
  167.   End;
  168. End;
  169.  
  170. Procedure KillDirList(Var Dir:DirList);
  171.  
  172. { ╔════════════════════════════════════════════════════════════════════════╗ }
  173. { ║  Removes all the information in the linked list Dir from memory.       ║ }
  174. { ╚════════════════════════════════════════════════════════════════════════╝ }
  175.  
  176. Var
  177.   Next:Pointer;
  178.  
  179. Begin
  180.   Dir.Info:=Dir.Root;
  181.   While Dir.Info<>NIL do
  182.   Begin
  183.     Next:=Dir.Info^.Next;
  184.     Dispose(Dir.Info);
  185.     Dir.Info:=Next;
  186.   End;
  187.   Dir.Total:=0;
  188.   Dir.Root :=NIL;
  189. End;
  190.  
  191. Procedure LoadDirList(Var Dir:DirList;Mask:PathStr;Attr,IncDir:Byte);
  192.  
  193. { ╔════════════════════════════════════════════════════════════════════════╗ }
  194. { ║  Loads a directory, specified by mask, into memory.  Only files with   ║ }
  195. { ║  attributes Attr are included.  Directories are also added to the list ║ }
  196. { ║  if IncDir >= Directory.   If files are already listed in the list Dir,║ }
  197. { ║  the files found are added to the end of the list.                     ║ }
  198. { ║                                                                        ║ }
  199. { ║  Assumes:  There is enough memory.                                     ║ }
  200. { ║            There are less than 65535 files in the directory.           ║ }
  201. { ║                                                                        ║ }
  202. { ║                   5 4 3 2 1 0                                          ║ }
  203. { ║  Attribute bits:  A D V S H R                                          ║ }
  204. { ╚════════════════════════════════════════════════════════════════════════╝ }
  205.  
  206. Var
  207.   P      :DirListInfo;
  208.   DirSrch:SearchRec;
  209.  
  210. Begin
  211.   FindFirst(Mask,Attr,DirSrch);
  212.   While (DosError=0) do
  213.   Begin
  214.     If (((DirSrch.Attr And Directory)<>0)  And ((IncDir And Directory)<>0))
  215.       Or (((DirSrch.Attr And Directory)=0) And ((IncDir And Files)<>0)) Then
  216.     Begin
  217.       New(P);
  218.       If Dir.Root=NIL Then
  219.       Begin
  220.         Dir.Total:=1;
  221.         Dir.Root :=P;
  222.         Dir.Info :=P;
  223.       End
  224.       Else
  225.       Begin
  226.         Inc(Dir.Total);
  227.         GotoDirList(Dir,65535);
  228.         Dir.Info^.Next:=P;
  229.       End;
  230.       P^.Next:=NIL;
  231.       P^.Attr:=DirSrch.Attr;
  232.       P^.Time:=DirSrch.Time;
  233.       P^.Size:=DirSrch.Size;
  234.       P^.Name:=DirSrch.Name;
  235.     End;
  236.     FindNext(DirSrch);
  237.   End;
  238. End;
  239.  
  240. End.
  241.  
  242. { Copyright 1993, Michael Gallias }
  243.